home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
forth
/
amiga
/
amigaker.arc
/
06.console
< prev
next >
Wrap
Text File
|
1987-12-30
|
15KB
|
368 lines
;
; 06.console
;
; Exec IO support routines, not included in the roms, but supplied
; with C. The routines below are the same
;
; Console support routines through which forth communicates
;
* setport (s pri name signal port task -- port )
; small word to set fields in a port struc.
dc.w -1
dc.l execlink3
execlink3 set *-4
dc.b $87,'setpor',$80!'t'
cnop 0,2
_setport dc.l *+4
move.l (sp)+,d0
move.l (sp)+,a0
move.l d0,16(a0) ;set task pointer
movem.l (sp)+,d0-d2
move.b d0,15(a0) ;signal bit
move.l d1,10(a0) ;name
move.b d2,9(a0) ;priority
move.b #4,8(a0) ;type to NT_MSGPORT
move.b #0,14(a0) ;flags to PA_SIGNAL
move.l a0,-(sp)
jmp (a3)
* CreatePort (s name pri -- port | 0 )
; creates a port structure for current task with a signal
; and a signal action, if a name is given the port is
; made public.
dc.w -1
dc.l execlink3
execlink3 set *-4
dc.b $8a,'CreatePor',$80!'t'
cnop 0,2
_CreatePort dc.l nest
dc.l _minus_1,_AllocSignal,_minus_1,_over,_equals
dc.l _question_branch,1$
dc.l _drop,_2drop,_0,_exit
1$ dc.l _nest_lit,$10001,_nest_lit,$22,_AllocMem
dc.l _question_dup,_0_equal,_question_branch,2$
dc.l _FreeSignal,_2drop,_0,_exit
2$ dc.l _to_r,_to_r,_over,_r_from,_r_from
dc.l _0,_FindTask,_setport,_tuck
dc.l _swap,_0_equal,_question_branch,3$
dc.l _nest_lit,20,_plus,_NewList,_branch,4$
3$ dc.l _AddPort
4$ dc.l _exit
* DeletePort (s port -- )
; deletes port structure created by the above routine.
dc.w -1
dc.l execlink0
execlink0 set *-4
dc.b $8a,'DeletePor',$80!'t'
cnop 0,2
_DeletePort dc.l *+4
move.l a3,-(rp) ;save @next restore at end
move.l (sp),a0 ;get port pointer
tst.l 10(a0) ;if named must remove port
beq.s 1$
move.l a0,-(sp) ;'like dup'
lea _RemPort,w
jsr docallrom
move.l (sp),a0 ;restore pointer
1$ moveq #-1,d0
move.b d0,8(a0) ;set node.type to xff
move.l d0,20(a0) ; and lh_head to -1
moveq #0,d0
move.b 15(a0),d0 ;get signal number.
move.l d0,-(sp)
lea _FreeSignal,w
jsr docallrom
pea 34 ;(s port size --
lea _FreeMem,w
jsr docallrom
move.l (rp)+,a3 ;restore @next
jmp (a3)
* CreateExtIO (s port size -- 'IOrequest )
; Allocates memory and initializes the IOrequest
; structure.
dc.w -1
dc.l execlink3
execlink3 set *-4
dc.b $8b,'CreateExtI',$80!'O'
cnop 0,2
_CreateExtIO dc.l nest
dc.l _over,_0_equal,_question_branch,1$
dc.l _2drop,_0,_exit
1$ dc.l _nest_lit,$10001,_over,_AllocMem
dc.l _question_dup,_0_equal,_question_branch,2$
dc.l _2drop,_0,_exit
2$ dc.l _dup,_to_r
dc.l _nest_lit,5,_over,_8_plus,_c_store ; type
dc.l _nest_lit,18,_plus,_w_store ; length
dc.l _r_fetch,_nest_lit,14,_plus,_store ; port
dc.l _r_from,_exit
* DeleteExtIO (s IOrequest -- )
; deletes user sized iorequest structure.
dc.w -1
dc.l execlink0
execlink0 set *-4
dc.b $8b,'DeleteExtI',$80!'O'
cnop 0,2
_DeleteExtIO dc.l *+4
move.l a3,-(rp) ;save @next
move.l (sp),a0 ;get request pointer
beq.s 1$ ; if zero do nothing
moveq #-1,d0
move.b d0,8(a0) ;set type to xff
move.l d0,20(a0) ; device to -1
move.l d0,24(a0) ; unit to -1
moveq #0,d0
move.w 18(a0),d0 ;get messagenode.length
move.l d0,-(sp) ;(s request length --
lea _FreeMem,w
jsr docallrom
1$ move.l (rp)+,a3 ;restore @next
jmp (a3)
* DeleteStdIO (s IOrequest -- ) frees up the memory for
; a standard IOrequest.
dc.w -1
dc.l execlink0
execlink0 set *-4
dc.b $8b,'DeleteExtI',$80!'O'
cnop 0,2
_DeleteStdIO dc.l nest
dc.l _DeleteExtIO,_exit
* CreateStdIO (s port -- 'IOStdrequest | 0 )
; Creates a StdIOrequest and sets port pointer to port.
dc.w -1
dc.l execlink3
execlink3 set *-4
dc.b $8b,'CreateStdI',$80!'O'
cnop 0,2
_CreateStdIO dc.l nest
dc.l _nest_lit,48,_CreateExtIO
dc.l _exit
; that's the end of the Exec support routines.
* ConWritePort (s -- addr ) A variable holding the address of
; console write port.
dc.w -1
dc.l link3
link3 set *-4
dc.b $8c,'ConWritePor',$80!'t'
cnop 0,2
_ConWritePort dc.l docreate
dc.l 0
* ConReadPort (s -- addr ) A variable holding the address of
; console read port.
dc.w -1
dc.l link3
link3 set *-4
dc.b $8b,'ConReadPor',$80!'t'
cnop 0,2
_ConReadPort dc.l docreate
dc.l 0
* ConWriteMsg (s -- addr ) Variable to hold the write message struct.
dc.w -1
dc.l link3
link3 set *-4
dc.b $8b,'ConWriteMs',$80!'g'
cnop 0,2
_ConWriteMsg dc.l docreate
dc.l 0
* ConReadMsg (s -- addr ) Variable holding the read message struct.
dc.w -1
dc.l link3
link3 set *-4
dc.b $8a,'ConReadMs',$80!'g'
cnop 0,2
_ConReadMsg dc.l docreate
dc.l 0
* MakeConStuff (s -- fl | t=ok. ) Sets up the ports and messages
; to read and write to a console.
dc.w -1
dc.l link1
link1 set *-4
dc.b $8c,'MakeConstuf',$80!'f'
cnop 0,2
_MakeConStuff dc.l nest
dc.l _nest_quote
dc.b 13,'4thcon.write',0
cnop 0,2
dc.l _drop,_0,_CreatePort
dc.l _dup,_0_notequal,_question_branch,1$
dc.l _dup,_ConWritePort,_store,_CreateStdIO
dc.l _dup,_0_notequal,_question_branch,1$
dc.l _ConWriteMsg,_store
dc.l _nest_quote
dc.b 12,'4thcon.read',0
cnop 0,2
dc.l _drop,_0,_CreatePort
dc.l _dup,_0_notequal,_question_branch,1$
dc.l _dup,_ConReadPort,_store,_CreateStdIO
dc.l _dup,_0_notequal,_question_branch,1$
dc.l _ConReadMsg,_store
dc.l _true
1$ dc.l _exit
* OpenConsole (s window -- fl ) Opens a console.device in the window.
; Sets the write message and clones the device in the
; read message.
; AND! -- Immediately queues up a read request using the
; external buffer * keybuffer * .
dc.w -1
dc.l link3
link3 set *-4
dc.b $8b,'OpenConsol',$80!'e'
cnop 0,2
_OpenConsole dc.l nest
dc.l _MakeConStuff,_0_equal,_question_branch,1$
dc.l _0,_exit
1$ dc.l _ConWriteMsg,_fetch,_tuck
dc.l _nest_lit,40,_plus,_store
dc.l _dup,_nest_quote
dc.b 15,'console.device',0
cnop 0,2
dc.l _drop,_0,_0,_OpenDevice,_0_notequal
dc.l _question_branch,2$,_drop,_0,_exit
2$ dc.l _nest_lit,20,_plus,_dup,_fetch,_swap
dc.l _4_plus,_fetch
dc.l _ConReadMsg,_fetch,_nest_lit,24,_plus,_tuck
dc.l _store,_4_minus,_store
dc.l _ConReadMsg,_fetch,_nest_lit,keybuffer,_QueRead
dc.l _true,_exit
* CloseConsole (s -- ) Closes the console device. Deletes the
; messages and ports.
dc.w -1
dc.l link3
link3 set *-4
dc.b $8c,'CloseConsol',$80!'e'
cnop 0,2
_CloseConsole dc.l nest
dc.l _ConWriteMsg,_fetch,_CloseDevice
dc.l _ConWriteMsg,_fetch,_DeleteStdIO
dc.l _ConReadMsg,_fetch,_DeleteStdIO
dc.l _ConWritePort,_fetch,_DeletePort
dc.l _ConReadPort,_fetch,_DeletePort
dc.l _exit
* QueRead (s 'request 'buffer -- ) Starts an asynchronous read
; request
dc.w -1
dc.l link1
link1 set *-4
dc.b $87,'QueRea',$80!'d'
cnop 0,2
_QueRead dc.l *+4
move.l (sp)+,d0
move.l (sp),a0
move.l d0,40(a0) ;set io_Data
moveq #1,d0
move.l d0,36(a0) ;set io_Length to 1
moveq #2,d0
move.w d0,28(a0) ;set io_Command to CMD_READ
move.l #_SendIO,w
move.l a3,-(rp)
jsr docallrom
move.l (rp)+,a3
jmp (a3)
* (key?) (s -- fl ) Word returns true if a key is available.
dc.w -1
dc.l link3
link3 set *-4
dc.b $86,'(key?',$80!')'
cnop 0,2
_nest_key_question
dc.l *+4
move.l d0,-(sp) ;prepare tos for flag
move.l _ConReadPort+4,a0 ;get port address
move.l 20(a0),a0 ;get msg_list pointer
tst.l (a0) ;if it points to 0 -> no messg.
beq no
bra yes
* (key) (s -- char ) Returns next keypress. Waits for it.
; This routine functions the same as page 287 RKM.
dc.w -1
dc.l link3
link3 set *-4
dc.b $85,'(key',$80!')'
cnop 0,2
_nest_key dc.l *+4
1$ move.l _ConReadPort+4,-(sp)
move.l a3,-(rp)
lea _GetMsg,w ;test for waiting messg
jsr docallrom
move.l (rp)+,a3
tst.l (sp)+
bne.s 2$
move.l _ConReadPort+4,-(sp)
move.l a3,-(rp) ;if no messg sleep until one
lea _WaitPort,w
jsr docallrom
move.l (rp)+,a3
addq.l #4,sp
bra.s 1$
2$ move.l _ConReadMsg+4,a0
lea keybuffer,a1
moveq #0,d0
move.b (a1),d0 ;get key from buffer
move.l d0,-(sp)
move.l a0,-(sp) ;and queue up the next read
move.l a1,-(sp) ;request
jmp _QueRead+4
* (type) (s addr len -- ) Type the string at the console.
; NOTE it also adds the length to #out.
dc.w -1
dc.l link0
link0 set *-4
dc.b $86,'(type',$80!')'
cnop 0,2
_nest_type dc.l *+4
move.l (sp)+,d0
move.l (sp)+,a0
move.l d0,-(rp)
move.l _ConWriteMsg+4,a1
move.l d0,36(a1)
move.l a0,40(a1)
moveq #3,d0
move.w d0,28(a1)
move.l a1,-(sp)
move.l a3,-(rp)
lea _DoIO,w
jsr docallrom
move.l (rp)+,a3
move.l (rp)+,d0
addq.l #4,sp
lea _number_out+4,a0
add.l d0,(a0)
jmp (a3)
* emit (s c -- ) Print character on the screen. This routine
; calls type to print the character, it uses * stdbuffer * to
; store the character, in order to call type.
; Type is deferred, so emit is also redirected if type is.
; Stdbuffer is also used by 'm-emits'(multiple emits) for temporary storage.
dc.w -1
dc.l link1
link1 set *-4
dc.b $84,'emi',$80!'t'
cnop 0,2
_emit dc.l nest
dc.l _stdbuffer,_c_store,_stdbuffer,_1
dc.l _type,_exit